BCI NET 2/BCI NET 2.iso/archives/programming/source/obrn-a_1.5_src.lha/oberon-a/source3.lha/Source/OEL/OEL.mod

Text File | 1995-01-23 | 10.1 KB | 329 lines

(*
 *      $DESCRIPTION: Oberon-A Error Lister $
 *      $AUTHOR: Johan Ferreira $
 *)

<* STANDARD- *>

MODULE  OEL;

IMPORT  SYSTEM, Exec, Dos, Locale, ErrorMessages, OELRev, Strings,
        IO := BufIO, ANSI, Msg := OELMsg, Errors, Kernel;


CONST   numOfArgs = 11;
        defModulePostfix = ".mod";
        defErrPostfix = ".err";
        defColWidth = 71;
        defColSeperator = " ";
        defTagLength = 1;
        defTabSize = 8;
        defErrPath = "T:";

        oaerIdSTR = "OAER";
        eclipseSTR = "...";
        programName = "OEL";
        maxString = 256;


VAR     E, R, W: Dos.FileHandlePtr;
        errline, errcol, preverrline, errno: INTEGER;
        modline, modcol: INTEGER;
        tab: INTEGER;
        eclipse, bool: BOOLEAN;
        i, m, n: LONGINT;
        strptr, errstrptr, prgname: Exec.LSTRPTR;

        module, modulePostfix, errPostfix, colSeperator, errPath: Exec.LSTRPTR;
        colWidth, tagLength, tabSize: LONGINT;
        lineNumbers, errNumbers(*, ansi*): BOOLEAN;
        argarray: ARRAY numOfArgs OF SYSTEM.LONGWORD;
        argresult: Dos.RDArgsPtr;


PROCEDURE PrintFault ();
BEGIN
        IF Dos.PrintFault (Dos.IoErr (), prgname^) THEN END
END PrintFault;


PROCEDURE WriteLineNumber ();
BEGIN
        IF lineNumbers THEN
                ANSI.BoldfaceText (W, FALSE, TRUE);
                IO.WriteF1 (W, "%-4ld", LONG (modline));
                ANSI.PlainText (W);
                IO.WriteStr (W, colSeperator^)
        END
END WriteLineNumber;


PROCEDURE WriteLine ();
BEGIN
        WriteLineNumber ();

        LOOP    IF (strptr^[i] # 00X) & (strptr^[i] # 0AX) THEN
                        IF strptr^[i] = 09X THEN
                                n := tabSize - (modcol MOD tabSize);
                                WHILE n > 0 DO
                                        IF ((modcol+1) MOD colWidth # 0) THEN
                                                IO.Write (W, " ");
                                                INC (modcol); DEC (n)
                                        ELSE    INC (modcol, SHORT (n)); n := 0;
                                                INC (i); EXIT
                                        END;
                                END
                        ELSE
                                IO.Write (W, strptr^[i]);
                                INC (modcol);
                        END;
                        INC (i)
                END;

                IF (strptr^[i] = 00X) OR (strptr^[i] = 0AX) THEN
                        modcol := MAX (INTEGER);
                        i := MAX (INTEGER);
                        EXIT
                ELSIF (modcol MOD colWidth = 0) THEN
                        EXIT
                END
        END;
        IO.WriteLn (W)
END WriteLine;


PROCEDURE WriteError ();
BEGIN
        IF lineNumbers THEN IO.WriteStr (W, "    ") END;
        m := ((errcol-1) MOD colWidth) + SYSTEM.STRLEN (colSeperator^);
        WHILE m > 0 DO
                IO.Write (W, " "); DEC (m)
        END;
        IO.Write (W, "^"); IO.WriteLn (W);

        ANSI.ItalicText (W, TRUE);
        IF errNumbers THEN IO.WriteF1 (W, "%ld: ", LONG (errno)) END;
        (* Internal errors *)
        IF (950 < errno) & (errno < 1000) THEN
                errstrptr := ErrorMessages.GetString (ErrorMessages.msgErr950);
                IO.WriteStr (W, errstrptr^)
        ELSIF (1000 < errno) & (errno < 1050) THEN
                errstrptr := ErrorMessages.GetString (ErrorMessages.msgErr1000);
                IO.WriteStr (W, errstrptr^)
        END;
        errstrptr := ErrorMessages.GetString (errno + 1);
        IF errstrptr # NIL THEN IO.WriteStr (W, errstrptr^)
        ELSE IO.WriteF1 (W, "Error #%ld", errno)
        END;
        IO.WriteLn (W);
        ANSI.PlainText (W)
END WriteError;


PROCEDURE ReadLine (output: BOOLEAN);
BEGIN
        WHILE output & (i # MAX (INTEGER)) DO
                WriteLine ()
        END;

        IF Dos.FGets (R, strptr^, maxString) = NIL THEN
                modline := MAX (INTEGER);
                modcol := MAX (INTEGER)
        ELSE
                i := 0;
                INC (modline);
                modcol := 0
        END
END ReadLine;


PROCEDURE WriteCopyright ();
BEGIN
        strptr := Msg.GetString (Msg.msgCopyright);
        IO.WriteF1 (NIL, strptr^, SYSTEM.ADR (OELRev.vers))
END WriteCopyright;


PROCEDURE ParseArgs ();

TYPE    LongPtr = POINTER [2] TO ARRAY 1 OF LONGINT;

VAR     lp: LongPtr;

        PROCEDURE ArgError ();
        BEGIN
                strptr := Msg.GetString (Msg.msgArgError);
                IO.WriteF1 (NIL, strptr^, prgname);
                HALT (Dos.error)
        END ArgError;

BEGIN
        FOR n := 0 TO numOfArgs-1 DO argarray[n] := SYSTEM.VAL (SYSTEM.LONGWORD, 0) END;
        argarray[1] := SYSTEM.ADR (defModulePostfix);
        argarray[2] := SYSTEM.ADR (defErrPostfix);
        argarray[4] := SYSTEM.ADR (defColSeperator);
        argarray[10] := SYSTEM.ADR (defErrPath);

        strptr := Msg.GetString (Msg.msgTemplate);
        argresult := Dos.OldReadArgs (strptr^, argarray, NIL);

        IF argresult = NIL THEN
                PrintFault ();
                HALT (Dos.error)
        END;

        module := SYSTEM.VAL (Exec.LSTRPTR, argarray[0]);
        modulePostfix := SYSTEM.VAL (Exec.LSTRPTR, argarray[1]);
        errPostfix := SYSTEM.VAL (Exec.LSTRPTR, argarray[2]);
        lp := SYSTEM.VAL (LongPtr, argarray[3]);
        IF lp = NIL THEN colWidth := defColWidth ELSE colWidth := lp[0] END;
        colSeperator := SYSTEM.VAL (Exec.LSTRPTR, argarray[4]);
        lineNumbers := (SYSTEM.VAL (LONGINT, argarray[5]) = 0);
        errNumbers := ~(SYSTEM.VAL (LONGINT, argarray[6]) = 0);
        ANSI.ansi := (SYSTEM.VAL (LONGINT, argarray[7]) = 0);

        lp := SYSTEM.VAL (LongPtr, argarray[8]);
        IF lp = NIL THEN tagLength := defTagLength ELSE tagLength := lp[0] END;
        IF tagLength < 0 THEN ArgError () END;

        lp := SYSTEM.VAL (LongPtr, argarray[9]);
        IF lp = NIL THEN tabSize := defTabSize ELSE tabSize := lp[0] END;
        IF tabSize <= 0 THEN ArgError () END;

        errPath := SYSTEM.VAL (Exec.LSTRPTR, argarray [10]);
END ParseArgs;


PROCEDURE Init ();
VAR     tag : ARRAY 5 OF CHAR;

        PROCEDURE NotErrorFile;
        VAR     msgstrptr: Exec.LSTRPTR;
        BEGIN
                msgstrptr := Msg.GetString (Msg.msgNotAnErrorFile);
                IO.WriteF2 (NIL, msgstrptr^, prgname, strptr);
                HALT (Dos.fail)
        END NotErrorFile;

BEGIN
        SYSTEM.NEW (strptr, maxString);
        SYSTEM.NEW (errstrptr, maxString);
        SYSTEM.NEW (prgname, 32);

        Msg.OpenCatalog (NIL, "");
        ErrorMessages.OpenCatalog (NIL, "");

        IF ~ Dos.GetProgramName (prgname^, 30) THEN prgname := SYSTEM.ADR (programName) END;

        ParseArgs ();
        COPY (errPath^, strptr^);
        IF Dos.AddPart (strptr^, module^, maxString) THEN END;
        Strings.Append (errPostfix^, strptr^);
        E := Dos.Open (strptr^, Dos.oldFile);
        IF E # NIL THEN
                IF Dos.Read (E, tag, 4) = 4 THEN
                        tag [4] := 0X; (* NUL-terminate the string *)
                        IF tag # oaerIdSTR THEN NotErrorFile() END
                ELSE    NotErrorFile()
                END;
        END;
        IF E = NIL THEN
                PrintFault ();
                HALT (Dos.warn)
        END;

        strptr^ := "";
        Strings.Append (module^, strptr^); Strings.Append (modulePostfix^, strptr^);
        R := Dos.Open (strptr^, Dos.oldFile);
        IF R = NIL THEN
                PrintFault ();
                HALT (Dos.fail)
        END;

        W := Dos.Output ();

        modline := 0; modcol := 0;
        errline := 0; errcol := 0;
        i := MAX (INTEGER)
END Init;


PROCEDURE *Close (VAR rc : LONGINT);
BEGIN
        ErrorMessages.CloseCatalog ();
        Dos.FreeArgs (argresult);

        IF W = Dos.Output () THEN
                IF Dos.Flush (W) THEN (* Error *) END
        ELSE    IF W # NIL THEN
                        IF Dos.Close (W) THEN (* Error *) END
                END
        END;
        IF R # NIL THEN
                IF Dos.Close (R) THEN (* Error *) END
        END;
        IF E # NIL THEN
                IF Dos.Close (E) THEN (* Error *) END
        END;

        Msg.CloseCatalog ()
END Close;


BEGIN   Errors.Init;
        argresult := NIL; W := NIL; R := NIL; E := NIL;
        Kernel.SetCleanup (Close);

        WriteCopyright ();
        Init ();

        LOOP    preverrline := errline;

                IF Dos.Read (E, errline, 2) < 2 THEN EXIT END;
                IF Dos.Read (E, errcol, 2) < 2 THEN EXIT END;
                IF Dos.Read (E, errno, 2) < 2 THEN EXIT END;

                (* Trailing lines *)
                WHILE (preverrline # 0) & (modline < preverrline + tagLength) & (modline < errline) DO
                        ReadLine (TRUE)         (* Output *)
                END;

                (* Skip *)
                eclipse := FALSE;
                WHILE (modline < errline - tagLength) DO
                        IF ~eclipse THEN
                                IO.WriteStr (W, eclipseSTR); IO.WriteLn (W);
                                eclipse := TRUE
                        END;
                        ReadLine (FALSE)        (* No output *)
                END;

                (* Leading lines *)
                WHILE (modline < errline) DO
                        ReadLine (TRUE)         (* Output *)
                END;

                (* Wrap the line *)
                WHILE (modcol < errcol) & (i # MAX (INTEGER)) DO
                        WriteLine ()
                END;

                (* If we reached the end of the source, then end *)
                IF (modline = MAX (INTEGER)) & (modcol = MAX (INTEGER)) THEN EXIT END;

                WriteError ()
        END;

        (* Trailing lines *)
        IF preverrline > errline THEN errline := preverrline END;
        WHILE (errline # 0) & (modline < errline + tagLength) DO
                ReadLine (TRUE)
        END;

        (* If not the end of souce, then write eclipse *)
        IF Dos.FGets (R, strptr^, maxString) # NIL THEN
                IO.WriteStr (W, eclipseSTR); IO.WriteLn (W)
        END
END OEL.